(use-modules (haunt asset)
             (haunt site)
             (haunt builder blog)
             (haunt builder atom)
             (haunt builder assets)
	     (haunt page)
	     (haunt html)
	     (haunt post)
	     (haunt reader)
             (haunt reader commonmark)
	     (srfi srfi-11)
	     (srfi srfi-19)
             (ice-9 match)
	     (ice-9 textual-ports))
;; TODOS
;; - implement static-page/md-format, which passes the md through a format call, so that I can centralise dates

(define %cc-by-sa-link
  '(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
      "CC-BY-SA-4.0"))

(define %cc-by-sa-button
  '(a (@ (class "cc-button")
         (href "https://creativecommons.org/licenses/by-sa/4.0/"))
      (img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png")))))

(define %base-url
  (or (getenv "BASEURL") ""))

(define %matomo-code
  `((script (@ (type "text/javascript") (src ,(string-append %base-url "/js/matomo.js"))))
    (noscript
     (p (img (@ (src "https://eldm2020.matomo.cloud/matomo.php?idsite=1&rec=1")
		(style "border:0;")
		(alt "")))))))

(define (stylesheet name)
  `(link (@ (rel "stylesheet")
            (href ,(string-append %base-url "/css/" name ".css")))))

(define (link name uri)
  `(a (@ (href ,uri)) ,name))

(define (link/inner name uri)
  (link name (string-append %base-url uri)))

(define (first-paragraph post)
  (let loop ((sxml (post-sxml post))
             (result '()))
    (match sxml
      (() (reverse result))
      ((or (('p ...) _ ...) (paragraph _ ...))
       (reverse (cons paragraph result)))
      ((head . tail)
       (loop tail (cons head result))))))

(define eldm-theme
  (theme #:name "eldm"
         #:layout
         (lambda (site title body)
           `((doctype "html")
             (head
              (meta (@ (charset "utf-8")))
	      (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
              (title ,(if title
			  (string-append title " — " (site-title site))
			  (site-title site)))
              ,(stylesheet "reset")
              ,(stylesheet "fonts")
              ,(stylesheet "eldm2020"))
             (body
              (div (@ (class "container"))
                   (div (@ (class "nav"))
                        (ul (li ,(link/inner "ELDM 2020" "/"))
                            (li (@ (class "fade-text")) " ")
                            ;; (li ,(link/inner "News" "/news.html"))
                            (li ,(link/inner "Call" "/call.html"))
                            (li ,(link/inner "Programme" "/programme.html"))
			    (li ,(link/inner "Practicalities" "/practicalities.html"))))
                   (div (@ (class "body")) ,body)
                   (footer
		    (p (@ (class "contact"))
		       "This workshop is organised by " ,(link "Sébastien Lerique" "https://slvh.fr/research/") "."
		       (br)
		       "Any questions, please email "
		       ,(link "sebastien.lerique@normalesup.org" "mailto:sebastien.lerique@normalesup.org")
		       ".")
		    (div (@ (class "smallprint"))
			 (p "This website's source code can be found "
			    ,(link "here" "https://gitlab.com/wehlutyk/eldm2020/tree/master/site")
			    ". It is built with "
			    ,(link "Haunt" "http://haunt.dthompson.us")
			    ", whose main page design was shamelessly copied here. Thank you David Thompson. "
			    (br)
			    "Unless otherwise noted, the text is © 2019 Sébastien Lerique, licensed under " ,%cc-by-sa-link "." ,%cc-by-sa-button))))
              ,%matomo-code)))
         #:post-template
         (lambda (post)
           `((h1 (@ (class "title")),(post-ref post 'title))
             (div (@ (class "date"))
                  ,(date->string (post-date post)
                                 "~B ~d, ~Y"))
             (div (@ (class "post"))
                  ,(post-sxml post))))
         #:collection-template
         (lambda (site title posts prefix)
           (define (post-uri post)
             (string-append "/" (or prefix "")
                            (site-post-slug site post) ".html"))

           `((h1 ,title)
             ,(map (lambda (post)
                     (let ((uri (string-append "/"
                                               (site-post-slug site post)
                                               ".html")))
                       `(div (@ (class "summary"))
                             (h2 (a (@ (href ,uri))
                                    ,(post-ref post 'title)))
                             (div (@ (class "date"))
                                  ,(date->string (post-date post)
                                                 "~B ~d, ~Y"))
                             (div (@ (class "post"))
                                  ,(first-paragraph post))
                             (a (@ (href ,uri)) "read more ➔"))))
                   posts)))))

(define %collections
  `(("News" "news.html" ,posts/reverse-chronological)))

(define (static-page/sxml title file-name body)
  (lambda (site posts)
    (make-page file-name
               (with-layout eldm-theme site title body)
               sxml->html)))

(define (make-static-page-reader reader)
  (lambda (title file-name body)
    (static-page/sxml
     title
     file-name
     (let-values (((metadata sxml) ((reader-proc reader) body)))
       sxml))))

(define static-page/md
  (make-static-page-reader commonmark-reader))

(define (static-page/raw file-name body)
  (lambda (site posts)
    (make-page file-name
	       body
	       display)))

(define fonts-css
  (static-page/raw
   "/css/fonts.css"
   (format
    #f
    (call-with-input-file "css-templates/fonts.css" get-string-all)
    %base-url)))

(define index-page
  (static-page/sxml
   #f
   "index.html"
   `((div (@ (class "banner"))
	  (h1 "Embodied interactions, Languaging"
	      (br)
	      "and the Dynamic Medium")
	  (h2 "Lyon, France — 18th February 2020"))
     (p "A workshop gathering interests and works in embodiment,
languaging, diversity computing and ethical technologies. Recent
developments in these communities are ripe for focused conversations,
cross-pollination and explorations of possible common futures.")
     (p "The " ,(link/inner "Call for Proposals" "/call.html") " is now
open and welcomes submissions from researchers, technologists and artists alike. Participation is free of charge, and refreshments will be provided.")
     (h3 "Important dates")
     (ul
      (li "Submission deadline: "
	  (strong "31st December 2019"))
      (li "Notification of acceptance: "
	  (strong "10th January 2020"))
      (li "Registration opens: "
	  (strong "11th January 2020"))))))

(define call-page
  (static-page/md "Call" "call.html" "pages/call.md"))

(define (speaker/invited name image website institution blurb)
  `(div (@ (class "speaker-invited"))
	(div (@ (class "image")) (img (@ (src ,(string-append %base-url "/images/" image)) (alt ,name))))
	(div (@ (class "name")) ,(link name website))
	(div (@ (class "institution")) (small ,institution))
	(div (@ (class "blurb")) ,blurb)))

(define programme-page
  (static-page/sxml
   "Programme"
   "programme.html"
   `((h1 "Invited speakers")
     ,(speaker/invited
       "Elena Clare Cuffari"
       "elena-clare-cuffari-original.jpg"
       "https://elenaclarecuffari.wordpress.com"
       "Worcester State University"
       "Drawing on a range of disciplines and disciplinary crossings,
but especially working in the enactive approach to mind and language,
Dr. Elena Clare Cuffari investigates the constitutive roles that our
bodies and interactions play in meaning creation and meaning
experience. She is Assistant Professor of Philosophy and Department
Chair of Philosophy at Worcester State University.")
     ,(speaker/invited
       "Mark Dingemanse"
       "mark-dingemanse-original.jpg"
       "https://www.mpi.nl/people/dingemanse-mark"
       "Radboud University"
       "Mark Dingemanse studies language as shaped by and for social
interaction. He is interested in how language enables us to express
ourselves and to act as one with others.")
     ,(speaker/invited
       "Omar Rizwan"
       "placeholder.png"  ;; TODO: add when received
       "https://rsnous.com/"
       "Dynamicland"
       "")
     ,(speaker/invited
       "Jelle van Dijk"
       "placeholder.png"
       "http://www.jellevandijk.org/"
       "University of Twente"
       "")
     (h1 "Programme")
     (p "Will first be published on 24th January 2020.")
     (h2 "Contributed abstracts")
     (p "Will first be published on 17th January 2020."))))

(define practicalities-page
  (static-page/sxml
   "Practicalities"
   "practicalities.html"
   `((h1 "Registration")
     (p "Participation is free of charge (thanks to funding from the "
	,(link "IXXI Complex Systems Institute" "http://www.ixxi.fr/")
	"), and food and refreshments will be provided.")
     (p "Registration is still required (for logistics), and will open on 11th January 2020.")
     (h1 "Venue")
     (p "Descartes Campus of the "
	,(link "École Normale Supérieure de Lyon" "http://www.ens-lyon.fr/")
	".")
     (p "Room number and directions will be published here towards the end of January 2020.")
     (div (@ (class "venue-map"))
      (iframe (@ (scrolling "no")
		 (src "https://www.openstreetmap.org/export/embed.html?bbox=4.82526183128357,45.729235996902204,4.842610359191895,45.73701680021645&layer=mapnik&marker=45.73312653406312,4.833936095237732")))
      (br)
      (small
       ,(link "View larger map" "https://www.openstreetmap.org/?mlat=45.73310&mlon=4.83401#map=17/45.73310/4.83401"))))))

(define 404-page
  (static-page/sxml
   "Page not found"
   "404.html"
   `((h1 "Oops! That's a 404.")
     (p "You stumbled into outer space, and who knows what lies there? In any case, this is not the page you're looking for. Maybe go back to the "
        ,(link/inner "main entrance" "/")
        "?"))))

(site #:title "ELDM 2020"
      #:domain "wehlutyk.gitlab.io"
      #:default-metadata
      '((author . "Sébastien Lerique")
        (email  . "sebastien.lerique@normalesup.org"))
      #:readers (list commonmark-reader)
      #:builders (list (blog #:theme eldm-theme #:collections %collections)
                       (atom-feed)
                       (atom-feeds-by-tag)
		       fonts-css
		       index-page
		       call-page
		       programme-page
		       practicalities-page
		       404-page
                       (static-directory "images")
		       (static-directory "css")
		       (static-directory "js")
		       (static-directory "fonts")))
